Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/printing/vbrotary/vbrotary.bas

BASIC Source File | 1995-07-12 | 20.2 KB | 575 lines

'***************************************************************************
'⌐Copyright 1995, P. Scott Antony
'P.O. Box 11047
'Milwaukee, WI  53211
'74002,[e-mail]
'[e-mail]
'Author of the Shareware programs: HOLIDAYS!⌐, and Easy Uploads⌐.
'***************************************************************************
'*** IMPORTANT ***

'AN INDIVIDUAL MAY USE THIS CODE FOR THEIR PERSONAL PROGRAMMING USE,
'COMPANIES MAY USE THIS CODE FOR THEIR "IN HOUSE" PROGRAMMING USE,
'OR ANYONE CAN USE THIS CODE IN A FREEWARE OR PUBLIC DOMAIN SOFTWARE PRODUCT,
'WITHOUT ROYALTY, FEE, OR REGISTRATION (although I'd still like to hear
'about your program - see below).

'ANYONE WISHING TO USE THE CODE IN A COMMERCIAL, OR SHAREWARE (FOR FEE)
'PROGRAM, MUST REGISTER WITH THE AUTHOR (ME). THERE'S NO CHARGE, BUT YOU
'MUST REGISTER IT'S USE. SIMPLY SEND A NOTE (EMAIL OR POSTAL TO THE ADDRESS
'ABOVE) NOTING YOUR NAME, AND THE PROGRAM YOU'RE INCLUDING IT IN.
'YOU DON'T HAVE TO WAIT TO GET ANYTHING BACK FROM ME. ONCE IT'S IN THE MAIL
'GO AHEAD, AND CONSIDER THAT IT'S REGISTERED (e.g. you won't be refused).

'(obviously there's no real good reason to make you do this, other than I
'enjoy getting email, and knowing how the code is being used. Also, please
'include where on CIS, or AOL I can find your program, and what it does).

'***************************************************************************
'Printing a Rotary (ROLODEX) Card

'This module will print Rotary Cards to the Printer object.
'It has been modularized so you can simply add it to your project,
'and print a card from ANY module or object.  All the necessary code
'and Constants you need are here.  Read On...

'If you like, you can also modify the code to print to a Form.
'Simply replace "Printer." with "Form1." (your form name), throughout the
'module, and then remove the Printer.EndDoc command from the Print_Rotary()
'subroutine, and the rDoEnd variable from the Sub declaration and
'calling statements. (See ROTARYFM.BAS)

'***************************************************************************
'   Subroutine for Printing a Rotary Card to the Printer Object
'   *Note the continuation character (_) below.
'   (e.g. the following would normally be entered on a single line).
'***************************************************************************
'Sub Print_Rotary (rBeginX As Double, rBeginY As Double, rSize As Integer, _
' rTab As Integer, rLineType As Integer, rCorner as Integer, rDoEnd As Integer)
'***************************************************************************

'   rBeginX and rBeginY are dimensions (MUST be in Inches) specifying the
'   upper left corner of the card (not including any Tab).

'* If you pass a Variable for rBeginX or rBeginY, instead of numbers,
'  it MUST be of 'Double' Type!

'   rSize is the Size of the Card. This code will Print either a 2╝" x 4"
'   or 3" x 5" Rotary Card. I've provided Constants below for this
'   (CARD_2x4 or CARD_3x5).

'   rTab is the Placement of the Tab. This code will Print either Left,
'   Right, or No Tab. I've provided Constants below for this
'   (NO_TAB, LEFT_TAB, or RIGHT_TAB).

'   rLineType is the Type of Line to use when drawing the card.
'   I've provided Constants below for this (SOLID_LINE, DASHED_LINE, etc.).

'   rCorner is the Type of Corner to draw on the card. BOTH types have
'   the rounded corner, but the square corners make it easier to cut
'   with a paper cutter. I've provided Constants below for this
'   (SQ_CORNER, RND_CORNER).

'   rDoEnd is a Boolean (True/False), whether to send the Printer.EndDoc()
'   command after finishing the card. This allows you to avoid muddying your
'   code with Printer statements, and you can print multiple cards on a page.

'***************************************************************************
'***  ENTERING YOUR OWN DATA

'*EMBEDDED* in the Print_Rotary() subroutine are calls to the other
'subroutines in this module. These other subroutines add the text to
'the card and tab, print the arcs for the corners, print the little scissors
'wingding, and the T hole.

'YOU WILL want to alter the Text in the PrintCardText(), and PrintTabText()
'subroutines to reflect YOUR DATA. The remaining three subroutines should
'not need to altered in any way.

'***  EMBEDDED Subroutines
'======================================================
'PrintTabText ()
'PrintCardText (rBeginX As Double, rBeginY As Double)

'PrintTHole ()
'PrintArc (Qdrnt As Integer, rRad As Double)
'PrintScissors (rBeginX As Double, rBeginY As Double)

'***************************************************************************
'EXAMPLES:
'* I like to see the parentheses (), so I MUST include the "Call" word.
'* You can omit the parentheses, as long as you also remove "Call".

'   Sub Print_1()
'       Call Print_Rotary(1, 1, CARD_2x4, LEFT_TAB, DOTTED_LINE, RND_CORNER, True)
'   End Sub

'The above will print a 2╝" x 4" card, positioned at X = 1", and Y = 1",
'with Dotted lines, rounded corners, and a Left tab. True will eject the page.

'The above, without the Constants, OR the "Call" could be entered as:

'       Print_Rotary 1, 1, 0, 1, 2, 1, True

'***************************************************************************
'Sub Print_3()
'   Call Print_Rotary(3.5, 1, CARD_2x4, RIGHT_TAB, SOLID_LINE, RND_CORNER, False)
'   Call Print_Rotary(3.5, 4, CARD_2x4, NO_TAB, DOTTED_LINE, SQ_CORNER, False)
'   Call Print_Rotary(2.5, 7, CARD_3x5, LEFT_TAB, DOTTED_LINE, RND_CORNER, True)
'End Sub

'*Notice the False, False, True pattern for the final parameter.

'The above will print two 2╝" x 4" cards down the right side of the page
'(rBeginX(1) = 3.5, which leaves a 1" margin on the right) with the second
'beginning 3 inches down the page after the first (rBeginY(1) = 1,
'rBeginY(2) = 4). Starting down yet another 3 inches (rBeginY(3) = 7)
'it prints a 3" x 5" card, which leaves a 1" margin on the bottom.
'Note that (rBeginX(3) = 2.5, which leaves a 1" margin on the right for the
'larger 5" card).

'The page is not ejected until Print_Rotary() receives a True for the rDoEnd
'parameter, so that these 3 cards would be printed on the same page.

'The above, without using the Constants could be entered as:

'       Call Print_Rotary(3.5, 1, 0, 2, 0, 1, False)
'       Call Print_Rotary(3.5, 4, 0, 0, 2, 0, False)
'       Call Print_Rotary(2.5, 7, 1, 1, 2, 1, True)

'***************************************************************************
'These variables are only DIMensioned for THIS module.

'ROTARY CARD VARIABLES
Dim RAD_CONV As Double
Dim rotTabX As Double
Dim rotTabY As Double
Dim rotNameX As Double
Dim rotNameY As Double
Dim rotWidth As Double
Dim rotHeight As Double
Dim rotMid As Double
Dim rotBar As Double
Dim rotMsg As String
Dim rotCurStyle As Integer
Dim rotArcColor As Integer

'These are Global Constants so you can call Print_Rotary() from any module.

'ROTARY CARD SIZE CONSTANTS
Global Const CARD_2x4 = 0
Global Const CARD_3x5 = 1

'ROTARY CARD TAB STYLES
Global Const NO_TAB = 0
Global Const LEFT_TAB = 1
Global Const RIGHT_TAB = 2

'ROTARY CARD LINE STYLES
Global Const SOLID_LINE = 0
Global Const DASHED_LINE = 1
Global Const DOTTED_LINE = 2
Global Const DASHDOT_LINE = 3
Global Const DASHDOTDOT_LINE = 4

'ROTARY CARD CORNER STYLES
Global Const SQ_CORNER = 0
Global Const RND_CORNER = 1

'PI
Global Const PI = 3.14159265358979     'used for RAD_CONV

'
'This is the Main Subroutine (it calls ALL other Subroutines in this module)
'
'Pass rBeginX and rBeginY as the "Upper Left Corner of the Rectangle" (in inches)
'* If you pass a Variable for rBeginX or rBeginY, instead of numbers,
'  it MUST be of 'Double' Type!
'
'Pass rSize from the CONSTANTS - CARD_2x4 (0) or CARD_3x5 (1)
'Pass rTab from the CONSTANTS - NO_TAB (0), or LEFT_TAB (1), or RIGHT_TAB (2)
'Pass rLineType from the CONSTANTS - SOLID_LINE (0), etc.
'Pass rCorner from the CONSTANTS - SQ_CORNER (0), RND_CORNER (1)
'Pass rDoEnd as True/False as to whether to send the Printer.EndDoc command
'
'EXAMPLE:
'Call Print_Rotary(1, 1, CARD_2x4, LEFT_TAB, DOTTED_LINE, RND_CORNER, True)
'
'  is the same as...
'Call Print_Rotary(1, 1, 0, 1, 2, 1, True)
'
'  is the same as...
'Print_Rotary 1, 1, 0, 1, 2, 1, True
'
Sub Print_Rotary (rBeginX As Double, rBeginY As Double, rSize As Integer, rTab As Integer, rLineType As Integer, rCorner As Integer, rDoEnd As Integer)

Select Case rSize

    '2╝" x 4" card
    Case 0  'I don't use the constants here, in case you delete them.
        rotWidth = 4
        rotHeight = 2.2
        rotMid = 7
        rBarX = 2.15
        rBarY = 1.5
        rotMsg = "For Your 2╝"" x 4"" Rotary File"

    '3" x 5" card
    Case 1  'I don't use the constants here, in case you delete them.
        rotWidth = 5
        rotHeight = 2.95
        rotMid = 15
        rBarX = 2.5
        rBarY = 2.25
        rotMsg = "For Your 3"" x 5"" Rotary File"
End Select
'Set the scale to inches
Printer.ScaleMode = 5
'DrawWidth must be 1 for dotted/dashed lines
Printer.DrawWidth = 1
Printer.DrawStyle = rLineType
'*************************************************************************
'compensate for rounded corners
If rCorner = 1 Then
    rotWidth = rotWidth - .1
    rotHeight = rotHeight - .1
End If
'top of card
Select Case rTab
    Case 0  'no Tab
        If rCorner = 1 Then
            'offset X and make room for next arc
            Printer.Line (rBeginX + .1, rBeginY)-Step(rotWidth - .1, 0)
        Else
            'start at the corner
            Printer.Line (rBeginX, rBeginY)-Step(rotWidth, 0)
        End If

    Case 1  'left Tab
        'begin the tab (angle up)
        Printer.Line (rBeginX, rBeginY)-Step(.2, -.3)
        '*************************************************************************
            'grab the CurrentX and CurrentY to put text here later
            rotTabX = Printer.CurrentX + .05
            rotTabY = Printer.CurrentY + .06
        '*************************************************************************
        'top of the tab
        Printer.Line Step(0, 0)-Step(1.95, 0)
        'finish the tab (angle down)
        Printer.Line Step(0, 0)-Step(.2, .3)
        'draw up to the right of the tab
        Printer.Line Step(0, 0)-Step(((rotWidth - 3) + .625), 0)

    Case 2  'Right Tab
        'draw up to the left of the tab
        If rCorner = 1 Then
            'don't offset Y and make room for next arc
            Printer.Line (rBeginX + .1, rBeginY)-Step(((rotWidth - 3) + .625), 0)
        Else
            'move back to the corner
            Printer.Line (rBeginX, rBeginY)-Step(((rotWidth - 3) + .625), 0)
        End If
        'begin the tab (angle up)
        Printer.Line Step(0, 0)-Step(.2, -.3)
        '*************************************************************************
            'grab the CurrentX and CurrentY to put tab text here later
            rotTabX = Printer.CurrentX + .05
            rotTabY = Printer.CurrentY + .06
        '*************************************************************************
        'top of the tab
        Printer.Line Step(0, 0)-Step(1.95, 0)
        'finish the tab (angle down)
        Printer.Line Step(0, 0)-Step(.2, .3)
End Select

If rTab <> 2 Then  'if not a right tab
    Call PrintArc(1, .1, rCorner)
End If

'down the right side
If rTab <> 2 Then 'I drew the arc
    If rCorner = 1 Then
        'don't offset Y and make room for next arc
        Printer.Line Step(.1, 0)-Step(0, rotHeight - .1)
    Else
        'move back to the corner
        Printer.Line Step(.1, -.1)-Step(0, rotHeight)
    End If
Else
    Printer.Line Step(0, 0)-Step(0, rotHeight)
End If

'add the lower right ARC
Call PrintArc(4, .1, rCorner)

'bottom right corner
If rCorner = 1 Then
    'don't offset X and compensate
    Printer.Line Step(0, .1)-Step(-((1 + rotMid / 16) - .1), 0)
Else
    'move back to the corner
    Printer.Line Step(.1, .1)-Step(-(1 + rotMid / 16), 0)
End If

'Print the T Hole
Call PrintTHole

'bottom middle
Printer.Line Step(0, 0)-Step(-.875, 0)

'Print the T Hole
Call PrintTHole

'bottom left corner
If rCorner = 1 Then
    'stop short
    Printer.Line Step(0, 0)-(rBeginX + .1, rBeginY + rotHeight + .1)
Else
    'move back to the corner
    Printer.Line Step(0, 0)-(rBeginX, rBeginY + rotHeight)
End If

'add the lower left ARC
Call PrintArc(3, .1, rCorner)

'left side
If rCorner = 1 Then
    If rTab <> 1 Then
        'don't offset Y and compensate
        Printer.Line Step(-.1, 0)-Step(0, -rotHeight + .1)
    Else
        'don't offset Y and compensate
        Printer.Line Step(-.1, 0)-Step(0, -rotHeight)
    End If
Else
    'move back to the corner
    Printer.Line Step(-.1, .1)-Step(0, -rotHeight)
End If

'add the upper left ARC
If rTab <> 1 Then
    Call PrintArc(2, .1, rCorner)
End If
'************************************************************
'Print the Scissors Wingding
Select Case rTab
    Case 1  'if a left tab, place on the right
        Call PrintScissors(rBeginX + rotWidth - .25, rBeginY)

    Case Else   'otherwise place on the left.
        Call PrintScissors(rBeginX, rBeginY)
End Select
'************************************************************
'middle vertical line (NOT the Exact middle, adjusted for MY text)
Printer.DrawWidth = 3   'big line
Printer.Line (rBeginX + rBarX, rBeginY + .125)-Step(0, rBarY)
Printer.DrawWidth = 1   'regular line
'************************************************************
'Description text under card
'Enable the following GoTo, to bypass this text.
'GoTo NoCardDesc
    Printer.FontName = "Arial"
    Printer.FontBold = False
    Printer.FontSize = 9.75
    Printer.CurrentX = rBeginX + ((rotWidth - Printer.TextWidth(rotMsg)) / 2)
    If rCorner = 1 Then
        Printer.CurrentY = rBeginY + rotHeight + .2
    Else
        Printer.CurrentY = rBeginY + rotHeight + .1
    End If
    Printer.Print rotMsg

NoCardDesc:
'************************************************************
'Enter Text on the Tab
Select Case rTab
    Case 0  'if no tab
        'do nothing
    Case Else   'otherwise print the tab
        Call PrintTabText
End Select
'************************************************************
'Enter Name/Address on the Card
Call PrintCardText(rBeginX, rBeginY)
'************************************************************
'eject the page if rDoEnd is True
If rDoEnd = True Then
    Printer.NewPage
    Printer.EndDoc
End If
'************************************************************
End Sub

Sub PrintArc (Qdrnt As Integer, rRad As Double, rCorner As Integer)
'Qdrnt = The quadrant to draw (see below)
'rRad  = The radius of the Arc.

rotCurStyle = Printer.DrawStyle    'grab the current DrawStyle

'enable the following line for ALWAYS DOTTED_LINE, or other.
'With this you can place a dotted arc on a solid frame, or any other
'combination. You could pass this parameter as well if you wish.

'Printer.DrawStyle = DOTTED_LINE

rRadX = rRad
rRadY = rRad
'radian conversion (sorry, I like degrees)
RAD_CONV = PI / 180
rotArcColor = 0    'black

'Print 1 of the 4 Arcs.
Select Case Qdrnt
    Case 1  'upper right
        If rCorner = 1 Then rRadX = 0   'assumes coming in from the left
        Printer.Circle Step(-rRadX, rRadY), rRad, QBColor(rotArcColor), (0 * RAD_CONV), (90 * RAD_CONV)

    Case 2  'upper left
        If rCorner = 1 Then rRadY = 0   'assumes coming in from the bottom
        Printer.Circle Step(rRadX, rRadY), rRad, QBColor(rotArcColor), (90 * RAD_CONV), (180 * RAD_CONV)

    Case 3  'lower left
        If rCorner = 1 Then rRadX = 0   'assumes coming in from the right
        Printer.Circle Step(rRadX, -rRadY), rRad, QBColor(rotArcColor), (180 * RAD_CONV), (270 * RAD_CONV)

    Case 4  'lower right
        If rCorner = 1 Then rRadY = 0   'assumes coming in from the top
        Printer.Circle Step(-rRadX, -rRadY), rRad, QBColor(rotArcColor), (270 * RAD_CONV), (0 * RAD_CONV)
End Select

Printer.DrawStyle = rotCurStyle   'reset to incoming DrawStyle

End Sub

Sub PrintCardText (rBeginX As Double, rBeginY As Double)

    'rBeginX and Y are passed UNALTERED from the calling routine,
    'so add an offset. DON't alter rBeginX and Y, so use your own
    'variable name (rotNameX and rotNameY).

    rotNameX = rBeginX + .15
    rotNameY = rBeginY + .15

    'set up the size, bold, etc.
    Printer.FontItalic = False
    Printer.FontBold = True
    Printer.FontSize = 12
    Printer.CurrentX = rotNameX
    Printer.CurrentY = rotNameY

    'company name
    'mine is a little strange, with the italics in the middle, so
    'you may want to alter this.
    'NOTE that the semicolon holds the CurrentX and CurrentY at the
    'end of the text, so they stay on the same line without a lot of fuss.
    Printer.Print "VB";
    Printer.FontItalic = True
    Printer.Print "rainStorm";
    Printer.FontItalic = False
    Printer.Print " Software";

    'set up the size, bold, etc.
    Printer.FontBold = False
    Printer.FontSize = 8.25
    Printer.Print "⌐"
    Printer.FontSize = 12
    Printer.FontBold = True

    'your name
    Printer.CurrentX = rotNameX
    Printer.CurrentY = Printer.CurrentY + .05 'add a little offset (optional)
    Printer.Print "P. Scott Antony"

    'your address
    Printer.FontBold = False
    Printer.FontSize = 9.75
    Printer.CurrentX = rotNameX
    Printer.Print "P.O. Box 11047"

    Printer.CurrentX = rotNameX
    Printer.Print "Shorewood, WI  53211"

    'add a blank line
    Printer.Print " "

    'On "The Net"
    Printer.FontBold = True
    Printer.CurrentX = rotNameX
    Printer.Print "On ""The Net"""
    Printer.FontBold = False

    Printer.CurrentX = rotNameX
    Printer.Print "[e-mail]"

    Printer.CurrentX = rotNameX
    Printer.Print "[e-mail]"

End Sub

Sub PrintScissors (rBeginX As Double, rBeginY As Double)

    'Print the Scissors Wingding
    On Error Resume Next    'if Wingdings is not installed
    Printer.FontName = "Wingdings"
    If Printer.FontName <> "Wingdings" Then Exit Sub
    Printer.FontBold = False
    Printer.FontSize = 12
    Printer.CurrentX = rBeginX
    Printer.CurrentY = rBeginY - .2
    Printer.Print "#"

End Sub

Sub PrintTabText ()

    'Enter Text on the Tab (only called if there is a tab requested).
    Printer.FontBold = True
    Printer.FontSize = 12
    'rotTabX and rotTabY were preset in Print_Rotary() while drawing the
    'line. You could also pass them to this routine if you prefer to
    'further modulize it for other tasks.
    Printer.CurrentX = rotTabX
    Printer.CurrentY = rotTabY

    'company name
    'mine is a little strange, with the italics in the middle, so
    'you may want to alter this.
    'NOTE that the semicolon holds the CurrentX and CurrentY at the
    'end of the text, so they stay on the same line.
    Printer.Print "VB";
    Printer.FontItalic = True
    Printer.Print "rainStorm";
    Printer.FontItalic = False
    Printer.Print " Software";
    Printer.FontBold = False
    Printer.FontSize = 8.25

    'this line does not have a semicolon so CurrentX and CurrentY "feed".
    Printer.Print "⌐"
    Printer.FontSize = 12

End Sub

Sub PrintTHole ()
'This subroutine STARTS the T Hole at the CURRENT X and Y positions.

rotCurStyle = Printer.DrawStyle    'grab the current DrawStyle

'enable the following line for ALWAYS DOTTED_LINE, or other.
'With this you can place a dotted T hole on a solid frame, or any other
'combination. You could pass this parameter as well if you wish.

'Printer.DrawStyle = DOTTED_LINE
Printer.Line Step(0, 0)-Step(0, -3 / 16)            'up
Printer.Line Step(0, 0)-Step(1 / 16, 0)             'right
Printer.Line Step(0, 0)-Step(0, -5 / 16)            'up
Printer.Line Step(0, 0)-Step(-1 / 4, 0)             'left
Printer.Line Step(0, 0)-Step(0, 5 / 16)             'down
Printer.Line Step(0, 0)-Step(1 / 16, 0)             'right
Printer.Line Step(0, 0)-Step(0, 3 / 16)             'down

Printer.DrawStyle = rotCurStyle   'reset to incoming DrawStyle

End Sub